#!/usr/bin/env gosh

;; Pick a theme
(import (scheme base)
        (scheme read)
        (scheme file)
        (scheme load)
        (scheme write)
        (srfi 27)
        (srfi 28))

(load "./name-gen.scm")
(load "./monster-gen.scm")
(load "./pretty-sxml.scm")
(load "./tavern-gen.scm")

(random-source-randomize! default-random-source)

(display "\n*** WELCOME TO RP HELPER *** \n\n")

(define data
  (let ((p (open-input-file "saved-game.sxml")))
    (define s (read p))
    (close-input-port p)
    s))

;; Game Variables
(define npcs
  (cdr (assq 'npcs data)))

(define current-place
  (cadr (assq 'location data)))

(define races
  (cdr (assq 'races data)))
;; End of Game Variables

(define (list-random l)
  (list-ref l (random-integer (length l))))

(define (printf . l)
  (display (apply format l)))

(define genres
  ;; Ideas from https://en.wikipedia.org/wiki/list_of_genres
  '(("action" "adventure" "espionage" "expedition")
    ("comedy" "dark comedy" "absurdism")
    ("courtroom drama" "whodunnit" "gangster" "hardboiled")
    ("haunted" "monster thriller" "occult horror"
     "gothic horror")
    ("supernatural mystery" "paranoia")
    ("dystopian" "political" "survival")
    ("romance" "slice of life")))

(define methods
  '("fighting"
    "talking"
    "plotting"
    "investigating"))

(define motivations
  '("is a religious fanatic"
    "wants revenge"
    "wants to conquer"
    "wants power"
    "wants money"
    "wants to advance science"
    "is a sadist"
    "wants love"
    "is possessed"
    "wants freedom"
    "wants knowledge"))

(define personalities
  '("cowardly"
    "brave"
    "stupid"
    "smart"
    "grumpy"
    "calm"
    "happy"
    "sad"
    "sinister"
    "rebellious"
    "obedient"
    "stingy"
    "fussy"
    "peculiar"
    "creepy"
    "scary"
    "well-meaning"
    "greedy"
    "affable"
    "likeable"
    "agreeable"
    "goofy"
    "silly"
    "blood-thirsty"
    "ruthless"
    "power-hungry"
    "zealous"
    "pious"))

(define person-types
  '("mysterious stranger"
    "aristocrat"
    "mercenary"
    "trader"
    "carpenter"
    "rogue"
    "priest"
    "bard"
    "blacksmith"
    "familiar face"
    "elder"
    "soldier"
    "rebel"
    "criminal"
    "priest"
    "king"
    "necromancer"
    "magician"
    "warlord"
    "summoner"
    "scientist"
    "noble"
    "slave"))

(define locations
  '("forest"
    "swamp"
    "castle"
    "cave"
    "mine"
    "desert"
    "lake"
    "swamp"
    "forest"
    "labyrinth"
    "distant land"))

(define twists
  '("you need to face a moral dilemma"
    "you need to make a heroic sacrifice"
    "the villain was good all along"
    "you were looking in the wrong place"
    "there is a bigger, stronger villain"
    "the quest-giver tricked you"))

(define climaxes
  '("One big bad"
    "Minion rush"
    "Faction war"))

(define alignments
  '("Lawful Good"
    "Good"
    "Chaotic Good"
    "Lawful"
    "True Neutral"
    "Chaotic"
    "Lawful Evil"
    "Evil"
    "Chaotic Evil"))

(define genders
  '("male"
    "female"))

(define encounters
  ;; Abstract ideas for encounters, starting with Tarot
  '("The Fool"
    "The Magician"
    "The High Priestess"
    "The Empress"
    "The Emperor"
    "The High Priest"
    "The Lovers"
    "The Chariot"
    "Strength"
    "Cowardice" ;; -str
    "The Hermit"
    "Wheel of Fortune"
    "Justice"
    "The Thief" ;; -just
    "The Hanged Man"
    "Death"
    "Temperance"
    "The Tower"
    "The Star"
    "The Moon"
    "The Sun"
    "Judgement"
    "The World"
    "The Merchant"
    "The Peasant"
    "The Oracle"
    "The Knight"
    "Pride"
    "Greed"
    "Lust"
    "Envy"
    "Gluttony"
    "Wrath"
    "Sloth"
    "Humility"
    "Charity"
    "Chastity"
    "Kindness"
    ;; Temperance
    "Patience"
    "Diligence"
    "The Ram"
    "The Bull"
    "The Twins"
    "The Crab"
    "The Lion"
    "The Maiden"
    "The Golden Scales"
    "The Scorpion"
    "The Archer"
    "The Goat"
    "The Water Carrier"
    "The Fish"
    "The Rat"
    "The Tiger"
    "The Rabbit"
    "The Dragon"
    "The Snake"
    "The Horse"
    "The Monkey"
    "The Rooster"
    "The Dog"
    "The Boar"
    "The Messenger" ;; Mercury
    "The Adulterer" ;; Jupiter
    "The Ocean" ;; Neptune
    "Heaven" ;; Uranus
    "Hell" ;; Pluto
    "The Assassin"
    "Nature"
    "The Artifact"
    "The Foreigner"
    "The Doctor"
    "The Leper"
    "The Alcoholic"
    "The Nomad"
    "The Rival"
    "The Foil"
    "The Hostage"
    "The Beginning"
    "The End"
    "Eternity"
    "The Blessing"
    "The Curse"
    "The Shapeshifter"
    "The Writer"
    "The Painter"
    "The Bard"
    "The Historian"
    "The Scientist"
    "The Philosopher"
    "The Apprentice"
    "The Royal Bastard"
    "Leviathan"
    "Behemoth"
    "Ziz"
    "The Slave"
    "The Slavemaster"
    "The Warlord"
    "The Resistance"
    "The Shadow"))

(define place-qualifiers
  '("haunted" "magical" "abandoned" "dangerous"
    "cursed" "ruined" "mysterious" "unexplored"
    "underground" "mystical" "secretive"
    "horrifying" "overgrown" "ancient"
    "well-defended" "stinky"))

(define monster-qualifiers
  '("fiery" "icy" "gigantic" "angry" "flying" "undead"
    "magical" "demonic" "mechanical" "possessed"
    "roaring"))

(define monster-types
  '("storm" "army" "monster" "curse" "ghost"
    "madman" "zealot" "cannibal" "beast" "dragon"
    "cat" "dog" "wolf"))

(define item-qualifiers
  '("lost" "stolen" "mythical" "fiery" "icy" "ancient"
    "glowing" "cursed" "demonic" "legendary"
    "lightning" "poison" "sonic"))

(define items
  '("sword" "necklace" "armor" "ring" "robe" "staff"
    "boots" "hat" "helmet" "gloves" "axe" "hammer"
    "tome" "scroll" "wand" "gauntlet" "knuckles"
    "talisman"))

(define rescue-types
  '("kidnapped" "lost" "enslaved"))

(define investigation-types
  '("murder" "theft" "mass death" "undead activity"))

(define resolution-types
  '("gang war" "drunken brawl" "land dispute"
    "family feud"))

(define missions
  `((("Explore a ")
     ,place-qualifiers
     (" ")
     ,locations
     (" infested with ")
     ,monster-qualifiers
     (" ")
     ,monster-types
     ("s."))
    (("Retrieve a ")
     ,item-qualifiers
     (" ")
     ,items
     (" from a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Rescue a ")
     ,rescue-types
     (" ")
     ,personalities
     (" ")
     ,person-types
     (" from a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Escape from a ")
     ,monster-qualifiers
     (" ")
     ,monster-types
     (" in a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Thwart a plot by a ")
     ,personalities
     (" ")
     ,person-types
     (" that ")
     ,motivations
     (" at a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Kill a ")
     ,(append monster-qualifiers personalities)
     (" ")
     ,(append person-types monster-types)
     (" that ")
     ,motivations
     (" at a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Search for a ")
     ,(append monster-qualifiers item-qualifiers)
     (" ")
     ,(append items monster-types)
     (" in a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Investigate a ")
     ,investigation-types
     (" occuring in a ")
     ,place-qualifiers
     (" ")
     ,locations
     (" with a prime suspect: a ")
     ,personalities
     (" ")
     ,person-types
     ("."))
    (("Resolve a ")
     ,resolution-types
     (" between ")
     ,personalities
     (" folk happening at a ")
     ,place-qualifiers
     (" ")
     ,locations
     ("."))
    (("Defend the ")
     ,place-qualifiers
     (" ")
     ,locations
     (" from the ")
     ,(append personalities monster-qualifiers)
     (" invaders."))
    (("Invade the ")
     ,place-qualifiers
     (" ")
     ,locations
     (" occupied by the ")
     ,(append personalities monster-qualifiers)
     (" inhabitants."))
    (("Escort a ")
     ,personalities
     (" ")
     ,person-types
     (" to go through a ")
     ,place-qualifiers
     (" ")
     ,locations
     (" occupied by ")
     ,monster-qualifiers
     (" ")
     ,(append monster-types person-types)
     ("s."))))

(define (pick-genre)
  (list-random (list-random genres)))

(define (pick-method)
  (list-random methods))

(define (pick-location)
  (list-random locations))

(define (pick-twist)
  (list-random twists))

(define (pick-climax)
  (list-random climaxes))

(define (pick-minor-npc)
  (list-random person-types))

(define (pick-major-npc)
  (define name (random-name))
  (define race (list-random races))
  (define personality (list-random personalities))
  (define type (list-random person-types))
  (define motive (list-random motivations))
  (set! npcs (cons
              `(npc (name ,name)
                    (description
                     ,(format "A ~a ~a that ~a."
                              personality
                              type
                              motive))
                    (race ,race))
              npcs))
  (format "~a ~a ~a named ~a, that ~a"
          personality
          race
          type
          name
          motive))

(define (pick-alignment)
  (define msg
    "Any restriction on alignment?\n
  1. Any
  2. Good
  3. Not good
  4. Evil
  5. Not evil
  6. Lawful
  7. Not lawful
  8. Chaotic
  9. Not chaotic\n\n> ")
  (define options
    '((0 1 2 3 4 5 6 7 8)
      (0 1 2)
      (3 4 5 6 7 8)
      (6 7 8)
      (0 1 2 3 4 5)
      (0 3 6)
      (1 2 4 5 7 8)
      (2 5 8)
      (0 1 3 4 6 7)))
  (define choice (- (prompt msg) 1))
  (list-ref alignments
            (list-random (list-ref options choice))))

(define (pick-gender)
  (list-random genders))

(define (pick-race)
  (list-random races))

(define (pick-align-gender-race)
  (format "A ~a ~a ~a.\n"
          (pick-alignment)
          (pick-gender)
          (pick-race)))

(define (pick-encounter)
  (list-random encounters))

(define (current-location)
  current-place)

(define (load-saved-game)
  (define g
    (let ((p (open-input-file "saved-game.sxml")))
      (define s (read p))
      (close-input-port p)
      s))
  (set! npcs (cdr (assq 'npcs g)))
  (set! current-place (cadr (assq 'location g)))
  (set! races (cdr (assq 'races g)))
  "Load successful.")

(define (write-saved-game)
  (let ((p (open-output-file "saved-game.sxml")))
    (pretty-print-sxml
     (list 'data
           (cons 'npcs npcs)
           (list 'location current-place)
           (cons 'races races))
     p)
    (close-output-port p))
  "Save successful.")

(define (print-game)
  (let ((p (open-output-string)))
    (pretty-print-sxml
     (list 'data
           (cons 'npcs npcs)
           (list 'location current-place)
           (cons 'races races))
     p)
    (let ((s (get-output-string p)))
      (close-output-port p)
      s)))

(define (set-current-location)
  (define msg
    "What is the name of your new location?\n\n> ")
  (display msg)
  (read-line)
  (let ((s (read-line)))
    (set! current-place s)
    s))

(define (list-npcs)
  (define (display-npc n)
    (define name (cadr (assq 'name n)))
    (define desc (cadr (assq 'description n)))
    (define race (cadr (assq 'race n)))
    (format "~a: ~a. ~a\n" name race desc))
  (apply
   string-append
   (map display-npc npcs)))

(define (pick-old-npc)
  (cadr (assq 'name (cdr (list-random npcs)))))

(define (pick-mission)
  (apply string-append
         (map list-random (list-random missions))))

(define (prompt s)
  (display s)
  (read))

(define msg
  "What do you need?\n
  1. A genre            2. A mission            3. Random method
  4. Minor NPC          5. Major NPC            6. Random place
  7. The twist          8. The climax           9. NPC stats
 10. Encounter theme   11. Current location    12. Set location
 13. List NPCs         14. Random known NPC    15. Random name
 16. New monster       17. Tavern name

  L. Load data
  P. Print data
  S. Save data
  0. Quit\n\n> ")

(define options
  (list '() pick-genre pick-mission pick-method
        pick-minor-npc pick-major-npc pick-location
        pick-twist pick-climax
        pick-align-gender-race pick-encounter
        current-location set-current-location
        list-npcs pick-old-npc random-name
        make-total-horror select-tavern))

(let loop ((in (prompt msg)))
  (unless (or (eof-object? in)
              (and (number? in)
                   (= in 0)))
    (cond
     ((symbol? in)
      (display
       (case in
         ((L l) (load-saved-game))
         ((S s) (write-saved-game))
         ((P p) (print-game))
         (else
          (error "loop" "No match found" in))))
      (newline)
      (newline)
      (loop (prompt msg)))
     (else
      (display ((list-ref options in)))
      (newline)
      (newline)
      (loop (prompt msg))))))

